#!/usr/bin/perl -wc

package RFCMail::ESMTP::Server::Parser;

use strict;
use warnings;
use RFCMail::ESMTP::Grammar::Base qw(:server);


sub new {
    my $class = shift;
    return (bless {@_}, $class);
}


sub new_standard {
    my $class = shift;
    $class->new('_'    => [undef,             'connect_handler'],
		'EHLO' => [DOMAIN_ARG_RE,     'ehlo_handler'],
		'HELO' => [DOMAIN_ARG_RE,     'ehlo_handler'],
		'MAIL' => [MAIL_ARGS_RE,      'mail_handler'],
		'RCPT' => [RCPT_ARGS_RE,      'rcpt_handler'],
		'DATA' => [undef,             'data_handler'],
		'RSET' => [undef,             'rset_handler'],
		'NOOP' => [OPT_STRING_ARG_RE, sub { [250, "OK"] }],
		'QUIT' => [undef,             'quit_handler'],
		'VRFY' => [STRING_ARG_RE,     'vrfy_handler', sub { 'VRFY' }],
		'HELP' => [OPT_STRING_ARG_RE, 'no_handler'],
		'EXPN' => [STRING_ARG_RE,     'no_handler'],
	       );
}


# Handlers for a refused session (see section 3.1)
sub new_refuser {
    my ($class, @welcome) = @_;
    @welcome = ("No SMTP service here")
	if not @welcome;
    $class->new('_'    => [undef,             sub { [554, @welcome] }],
		'EHLO' => [DOMAIN_ARG_RE,     'bad_seq_handler'],
		'HELO' => [DOMAIN_ARG_RE,     'bad_seq_handler'],
		'MAIL' => [MAIL_ARGS_RE,      'bad_seq_handler'],
		'RCPT' => [RCPT_ARGS_RE,      'bad_seq_handler'],
		'DATA' => [undef,             'bad_seq_handler'],
		'RSET' => [undef,             'bad_seq_handler'],
		'NOOP' => [OPT_STRING_ARG_RE, 'bad_seq_handler'],
		'QUIT' => [undef,             'quit_handler'],
		'VRFY' => [STRING_ARG_RE,     'bad_seq_handler'],
		'HELP' => [OPT_STRING_ARG_RE, 'no_handler'],
		'EXPN' => [STRING_ARG_RE,     'no_handler'],
	       );
}


sub set {
    my ($self, $cmd, @data) = @_;
    if (@data) { $self->{$cmd} = [@data] }
    else { delete($self->{$cmd}) }
    return ($self);
}


sub ehlo_methods {
    my ($self) = @_;
    my @methods;
    for (values %$self) {
	push @methods, $_->[2]
	    if $_->[2];
    }
    return (@methods);
}


sub parse_line {
    my ($self, $line) = @_;
    my ($cmd, $args) = $line =~ /@{[COMMAND_RE]}/o;
    return (sub { [500, "Syntax error"] })
	if not defined($cmd);
    $cmd = uc($cmd);
    return ($self->parse_cmd($cmd, $args));
}


sub parse_cmd {
    my ($self, $cmd, $args) = @_;
    return (sub { [500, "Syntax error: command unrecognised"] })
	if not defined($self->{$cmd});
    my ($re, $method) = @{$self->{$cmd}};
    if (defined($re)) {
	$args = ""
	    if not defined($args);
	my @result = $args =~ /$re/;
	return ($method, $cmd, @result)
	    if @result;
    }
    return ($method, $cmd)
	if not defined($args);
    return (sub { [501, "Syntax error: arguments not valid for $cmd"] });
}


1;
